home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / surfsrc3.zip / ANSICRT.PAS < prev    next >
Pascal/Delphi Source File  |  1989-08-10  |  4KB  |  206 lines
  1. { Unit to implement most of the CRT functions using ANSI.SYS}
  2. { Some unsimulatable functions (normally input) are done using CRT unit }
  3.  
  4. unit ansicrt;
  5. INTERFACE
  6. uses CRT;
  7.  
  8. CONST
  9.   BW40    = 0;    { 40x25 B/W on Color Adapter   }
  10.   CO40    = 1;    { 40x25 Color on Color Adapter }
  11.   BW80    = 2;    { 80x25 B/W on Color Adapter   }
  12.   CO80    = 3;    { 80x25 Color on Color Adapter }
  13.   Mono    = 7;    { 80x25 on Monochrome Adapter  }
  14.   Font8x8 = 256;  { Add-in for ROM font          }
  15.  
  16.   { Mode constants for 3.0 compatibility }
  17.   C40     = CO40;
  18.   C80     = CO80;
  19.  
  20.   { Foreground and Background color constants }
  21.   Black     = 0;
  22.   Blue      = 1;
  23.   Green     = 2;
  24.   Cyan      = 3;
  25.   Red       = 4;
  26.   Magenta   = 5;
  27.   Brown     = 6;
  28.   LightGray = 7;
  29.  
  30.   { Foreground color constants }
  31.   DarkGray     = 8;
  32.   Lightblue    = 9;
  33.   LightGreen   = 10;
  34.   LightCyan    = 11;
  35.   LightRed     = 12;
  36.   LightMagenta = 13;
  37.   Yellow       = 14;
  38.   White        = 15;
  39.  
  40.   { Add-in for blinking }
  41.   Blink        = 128;
  42.  
  43. VAR
  44.   checkbreak  : boolean;  { Enable CTRL-BREAK }
  45.   CheckEOF    : boolean;  { Enable Ctrl-Z }
  46.   DirectVideo : Boolean;  { Enable Direct Video Addressing}
  47.   CheckSnow   : Boolean;  { Enable snow filtering }
  48.   LastMode    : Word;     { Current Text Mode }
  49.   TextAttr    : Byte;     { Current Text Attribute }
  50.   WindMin     : word;     { Window upper left coordinates }
  51.   WindMax     : word;     { Window lower right coordinates }
  52.   SaveInt1b   : Pointer;  { Saved interrupt $1B }
  53.  
  54.   Procedure AssignCrt (var F: Text);
  55.   Function keypressed : boolean;
  56.   Function Readkey    : char;
  57.   Procedure Textmode (mode:word);
  58.   Procedure Window (X1,Y1,X2,Y2 : byte);
  59.   Procedure GotoXY(X,Y: Byte);
  60.   Function WhereX: Byte;
  61.   Function WhereY: Byte;
  62.   Procedure ClrScr;
  63.   Procedure ClrEol;
  64.   Procedure InsLine;
  65.   Procedure DelLine;
  66.   Procedure TextColor(color:byte);
  67.   Procedure TextBackground(Color: Byte);
  68.   Procedure LowVideo;
  69.   Procedure HighVideo;
  70.   Procedure NormVideo;
  71.   Procedure Delay(ms: Word);
  72.   Procedure Sound(Hz: Word);
  73.   Procedure NosSound;
  74.  
  75. IMPLEMENTATION
  76.  
  77.    var
  78.      crtfil : text;
  79.      xoffset : byte;
  80.      yoffset : byte;
  81.  
  82.    CONST
  83.      ESC = ^[;
  84.  
  85.   {Emulated Functions}
  86.   Procedure GotoXY(X,Y: Byte);
  87.   begin
  88.     write(crtfil,ESC,'[',y+yoffset,';',x+xoffset,'H');
  89.   end;
  90.  
  91.   Procedure Textmode (mode:word);
  92.   begin
  93.     write (crtfil,ESC,'[',mode,'h');
  94.   end;
  95.  
  96.   Procedure ClrScr;
  97.   begin
  98.     write (crtfil,ESC,'[2J');
  99.     gotoxy (1,1);
  100.   end;
  101.  
  102.   Procedure ClrEol;
  103.   begin
  104.     write (crtfil,ESC,'[K');
  105.   end;
  106.  
  107.   Procedure TextColor(color:byte);
  108.   begin
  109.     if color > 7 then
  110.       write (crtfil,ESC,'[1;',color+30 - 8,'m')
  111.     else
  112.       write (crtfil,ESC,'[',color+30,'m');
  113.   end;
  114.  
  115.   Procedure TextBackground(Color: Byte);
  116.   begin
  117.     write (crtfil,ESC,'[',color,'m');
  118.   end;
  119.  
  120.   Procedure LowVideo;
  121.   begin
  122.     write (crtfil,ESC,'[0m');
  123.   end;
  124.  
  125.   Procedure HighVideo;
  126.   begin
  127.     write (crtfil,ESC,'[1m');
  128.   end;
  129.  
  130.   Procedure NormVideo;
  131.   begin
  132.     lowvideo
  133.   end;
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.  
  141.   {Unemulated functions}
  142.   Procedure AssignCrt (var F: Text);
  143.   begin
  144.     crt.assigncrt (f);
  145.   end;
  146.  
  147.   Function keypressed : boolean;
  148.   begin
  149.     keypressed := crt.keypressed;
  150.   end;
  151.  
  152.   Function Readkey    : char;
  153.   begin
  154.     readkey := crt.readkey;
  155.   end;
  156.  
  157.   Procedure Window (X1,Y1,X2,Y2 : byte);
  158.   begin
  159.     crt.window (x1,y1,x2,y2);
  160.     xoffset := x1 - 1;
  161.     yoffset := y1 - 1;
  162.   end;
  163.  
  164.  
  165.   Function WhereX: Byte;
  166.   begin
  167.     wherex := crt.wherex;
  168.   end;
  169.  
  170.   Function WhereY: Byte;
  171.   begin
  172.     wherey := crt.wherey;
  173.   end;
  174.  
  175.   Procedure InsLine;
  176.   begin
  177.     crt.insline;
  178.   end;
  179.  
  180.   Procedure DelLine;
  181.   begin
  182.     crt.delLine;
  183.   end;
  184.  
  185.  
  186.   Procedure Delay(ms: Word);
  187.   begin
  188.     crt.delay(ms);
  189.   end;
  190.  
  191.   Procedure Sound(Hz: Word);
  192.   begin
  193.     crt.sound(hz);
  194.   end;
  195.  
  196.   Procedure NosSound;
  197.   begin
  198.     crt.nosound;
  199.   end;
  200.  
  201. begin
  202.   xoffset := 0;
  203.   yoffset := 0;
  204.   assign (crtfil,'');
  205.   rewrite (crtfil);
  206. end.